home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1996 May: Tool Chest / Developer CD Series May 1996 (Tool Chest) (Apple Computer) (1996).iso / Tool Chest / Development Tools & Languages / Dylan Related / Mindy / Mindy 1.2 - portable sources / interp / num.c < prev    next >
Encoding:
C/C++ Source or Header  |  1995-03-15  |  58.3 KB  |  2,234 lines  |  [TEXT/ttxt]
  1. /**********************************************************************\
  2. *
  3. *  Copyright (c) 1994  Carnegie Mellon University
  4. *  All rights reserved.
  5. *  
  6. *  Use and copying of this software and preparation of derivative
  7. *  works based on this software are permitted, including commercial
  8. *  use, provided that the following conditions are observed:
  9. *  
  10. *  1. This copyright notice must be retained in full on any copies
  11. *     and on appropriate parts of any derivative works.
  12. *  2. Documentation (paper or online) accompanying any system that
  13. *     incorporates this software, or any part of it, must acknowledge
  14. *     the contribution of the Gwydion Project at Carnegie Mellon
  15. *     University.
  16. *  
  17. *  This software is made available "as is".  Neither the authors nor
  18. *  Carnegie Mellon University make any warranty about the software,
  19. *  its performance, or its conformity to any specification.
  20. *  
  21. *  Bug reports, questions, comments, and suggestions should be sent by
  22. *  E-mail to the Internet address "gwydion-bugs@cs.cmu.edu".
  23. *
  24. ***********************************************************************
  25. *
  26. * $Header: num.c,v 1.17 94/11/28 15:37:39 wlott Exp $
  27. *
  28. * This file implements numbers.
  29. *
  30. \**********************************************************************/
  31.  
  32. #include "../compat/std-c.h"
  33. #include <math.h>
  34.  
  35. #include "mindy.h"
  36. #include "gc.h"
  37. #include "class.h"
  38. #include "obj.h"
  39. #include "bool.h"
  40. #include "def.h"
  41. #include "list.h"
  42. #include "type.h"
  43. #include "num.h"
  44. #include "thread.h"
  45. #include "func.h"
  46. #include "error.h"
  47. #include "print.h"
  48. #include "module.h"
  49. #include "sym.h"
  50.  
  51. obj_t obj_NumberClass = 0;
  52. obj_t obj_ComplexClass = 0;
  53. obj_t obj_RealClass = 0;
  54. obj_t obj_RationalClass = 0;
  55. obj_t obj_IntegerClass = 0;
  56. obj_t obj_FixnumClass = 0;
  57. obj_t obj_BignumClass = 0;
  58. obj_t obj_RatioClass = 0;
  59. obj_t obj_FloatClass = 0;
  60. obj_t obj_SingleFloatClass = 0;
  61. obj_t obj_DoubleFloatClass = 0;
  62. obj_t obj_ExtendedFloatClass = 0;
  63.  
  64. #define MAX(m, n) (((m) > (n)) ? (m) : (n))
  65.  
  66.  
  67.  
  68. /* Simple constructors */
  69.  
  70. obj_t make_ratio(obj_t numerator, obj_t denominator)
  71. {
  72.     obj_t res = alloc(obj_RatioClass, sizeof(struct ratio));
  73.  
  74.     RATIO(res)->numerator = numerator;
  75.     RATIO(res)->denominator = denominator;
  76.  
  77.     return res;
  78. }
  79.  
  80. obj_t make_single(float value)
  81. {
  82.     obj_t res = alloc(obj_SingleFloatClass, sizeof(struct single_float));
  83.  
  84.     obj_ptr(struct single_float *, res)->value = value;
  85.  
  86.     return res;
  87. }
  88.  
  89. obj_t make_double(double value)
  90. {
  91.     obj_t res = alloc(obj_DoubleFloatClass, sizeof(struct double_float));
  92.  
  93.     obj_ptr(struct double_float *, res)->value = value;
  94.  
  95.     return res;
  96. }
  97.  
  98. obj_t make_extended(long double value)
  99. {
  100.     obj_t res = alloc(obj_ExtendedFloatClass, sizeof(struct extended_float));
  101.  
  102.     obj_ptr(struct extended_float *, res)->value = value;
  103.  
  104.     return res;
  105. }
  106.  
  107.  
  108. /* Extended Integer Support */
  109.  
  110. #define SIGN_MASK 0x80
  111. #define DIGIT_MASK 0xff
  112. #define DIGIT_BITS 8
  113. #define SIGN(e) (BIGNUM(e)->digits[BIGNUM(e)->length-1] & SIGN_MASK)
  114. #define ZEROP(e) (BIGNUM(e)->length == 1 && BIGNUM(e)->digits[0] == 0)
  115. #define PAD(e) ((SIGN(e)) ? (DIGIT_MASK) : (0))
  116.  
  117. static obj_t alloc_bignum(int length)
  118. {
  119.     obj_t res = alloc(obj_BignumClass,
  120.               sizeof(struct bignum) + (length-1) * sizeof(digit_t));
  121.  
  122.     BIGNUM(res)->length = length;
  123.  
  124.     return res;
  125. }
  126.  
  127. static void shrink_bignum(obj_t num, int length)
  128. {
  129.     shrink(num, sizeof(struct bignum) + (length - 1) * sizeof(digit_t));
  130.     BIGNUM(num)->length = length;
  131. }
  132.  
  133. obj_t make_bignum(long value)
  134. {
  135.     obj_t res = alloc_bignum(sizeof(long) / sizeof(digit_t));
  136.     digit_t *ptr = BIGNUM(res)->digits;
  137.     boolean sign;
  138.  
  139.     if (value < 0)
  140.     do {
  141.         sign = value & SIGN_MASK;
  142.         *ptr++ = value & DIGIT_MASK;
  143.         value >>= DIGIT_BITS;
  144.     } while (value != -1 || !sign);
  145.     else
  146.     do {
  147.         sign = value & SIGN_MASK;
  148.         *ptr++ = value & DIGIT_MASK;
  149.         value >>= DIGIT_BITS;
  150.     } while (value != 0 || sign);
  151.  
  152.     shrink_bignum(res, ptr - BIGNUM(res)->digits);
  153.  
  154.     return res;
  155. }
  156.  
  157. long bignum_value(obj_t bignum)
  158. {
  159.     int length = BIGNUM(bignum)->length;
  160.     digit_t *digits = BIGNUM(bignum)->digits;
  161.     int i;
  162.     long res = 0;
  163.  
  164.     if (digits[length-1] & SIGN_MASK)
  165.     res = -1;
  166.  
  167.     for (i = length - 1; i >= 0; i--)
  168.     res = (res << DIGIT_BITS) | digits[i];
  169.  
  170.     return res;
  171. }
  172.  
  173. static void dump_bignum(obj_t bignum, int length)
  174. {
  175.     digit_t *digits = BIGNUM(bignum)->digits;
  176.     digit_t *ptr = digits + length;
  177.  
  178.     while (ptr-- > digits) {
  179.     printf("%02x ", *ptr);
  180.     }
  181.     printf("(%d)", length);
  182. }
  183.  
  184. static obj_t extend_bignum(obj_t bignum, int length)
  185. {
  186.     obj_t res;
  187.     int extend;
  188.     int i;
  189.  
  190.     if (SIGN(bignum))
  191.     extend = DIGIT_MASK;
  192.     else
  193.     extend = 0;
  194.  
  195.     if (BIGNUM(bignum)->length < length)
  196.     res = alloc_bignum(length);
  197.     else
  198.         res = alloc_bignum(BIGNUM(bignum)->length);
  199.  
  200.     memcpy(BIGNUM(res)->digits, BIGNUM(bignum)->digits,
  201.        BIGNUM(bignum)->length * sizeof(digit_t));
  202.  
  203.     for (i = BIGNUM(bignum)->length; i < length; i++)
  204.     BIGNUM(res)->digits[i] = extend;
  205.  
  206.     return res;
  207. }
  208.  
  209. static void normalize_bignum(obj_t bignum, int length)
  210. {
  211.     digit_t *digits = BIGNUM(bignum)->digits;
  212.     digit_t *ptr = digits + length - 1;
  213.     int useless = (*ptr & SIGN_MASK) ? DIGIT_MASK : 0;
  214. /*
  215.     printf("normalizing "); dump_bignum(bignum, length);
  216. */
  217.     while (ptr > digits && *ptr == useless)
  218.     ptr--;
  219.  
  220.     if ((*ptr & SIGN_MASK) == (useless & SIGN_MASK))
  221.     shrink_bignum(bignum, ptr - digits + 1);
  222.     else
  223.     shrink_bignum(bignum, ptr - digits + 2);
  224. /*
  225.     printf(" is "); dump_bignum(bignum, BIGNUM(bignum)->length); printf("\n");
  226. */
  227. }
  228.  
  229. int compare_bignums(obj_t x, obj_t y)
  230. {
  231.     digit_t *x_digits = BIGNUM(x)->digits;
  232.     digit_t *y_digits = BIGNUM(y)->digits;
  233.     int x_length = BIGNUM(x)->length;
  234.     int y_length = BIGNUM(y)->length;
  235.     int i;
  236.  
  237.     if (x_digits[x_length-1] & SIGN_MASK) {
  238.     if (y_digits[y_length-1] & SIGN_MASK) {
  239.         if (x_length > y_length)
  240.         return -1;
  241.         else if (x_length < y_length)
  242.         return 1;
  243.         else
  244.         ; /* fall though */
  245.     }
  246.     else
  247.         return -1;
  248.     }
  249.     else {
  250.     if (y_digits[y_length-1] & SIGN_MASK)
  251.         return 1;
  252.     else {
  253.         if (x_length > y_length)
  254.         return 1;
  255.         else if (x_length < y_length)
  256.         return -1;
  257.         else
  258.         ; /* fall though */
  259.     }
  260.     }
  261.  
  262.     for (i = x_length-1; i >= 0; i--) {
  263.     digit_t x_digit = x_digits[i];
  264.     digit_t y_digit = y_digits[i];
  265.  
  266.     if (x_digit != y_digit)
  267.         return x_digit - y_digit;
  268.     }
  269.     return 0;
  270. }
  271.  
  272. obj_t add_bignums(obj_t x, obj_t y)
  273. {
  274.     int len1 = BIGNUM(x)->length;
  275.     int len2 = BIGNUM(y)->length;
  276.     int length = MAX(len1, len2) + 1;
  277.     obj_t res = alloc_bignum(length);
  278.     digit_t *result = BIGNUM(res)->digits;
  279.     digit_t *digits1 = BIGNUM(x)->digits;
  280.     digit_t *digits2 = BIGNUM(y)->digits;
  281.     int pad1 = PAD(x);
  282.     int pad2 = PAD(y);
  283.     int i, carry = 0;
  284.  
  285.     if (len1 < len2) {
  286.     for (i = 0; i < len1; i++) {
  287.         int sum = digits1[i] + digits2[i] + carry;
  288.         result[i] = sum & DIGIT_MASK;
  289.         carry = sum >> DIGIT_BITS;
  290.     }
  291.     for (i = len1; i < len2; i++) {
  292.         int sum = pad1 + digits2[i] + carry;
  293.         result[i] = sum & DIGIT_MASK;
  294.         carry = sum >> DIGIT_BITS;
  295.     }
  296.     }
  297.     else {
  298.     for (i = 0; i < len2; i++) {
  299.         int sum = digits1[i] + digits2[i] + carry;
  300.         result[i] = sum & DIGIT_MASK;
  301.         carry = sum >> DIGIT_BITS;
  302.     }
  303.     for (i = len2; i < len1; i++) {
  304.         int sum = digits1[i] + pad2 + carry;
  305.         result[i] = sum & DIGIT_MASK;
  306.         carry = sum >> DIGIT_BITS;
  307.     }
  308.     }
  309.     result[length - 1] = (pad1 + pad2 + carry) & DIGIT_MASK;
  310.     normalize_bignum(res, length);
  311. /*
  312.     printf("adding "); dump_bignum(x, BIGNUM(x)->length);
  313.     printf(" and "); dump_bignum(y, BIGNUM(y)->length);
  314.     printf(" is "); dump_bignum(res, BIGNUM(res)->length); printf("\n");
  315. */
  316.     return res;
  317.  
  318. }
  319.  
  320. obj_t subtract_bignums(obj_t x, obj_t y)
  321. {
  322.     int len1 = BIGNUM(x)->length;
  323.     int len2 = BIGNUM(y)->length;
  324.     int length = MAX(len1, len2) + 1;
  325.     obj_t res = alloc_bignum(length);
  326.     digit_t *result = BIGNUM(res)->digits;
  327.     digit_t *digits1 = BIGNUM(x)->digits;
  328.     digit_t *digits2 = BIGNUM(y)->digits;
  329.     int pad1 = PAD(x);
  330.     int pad2 = PAD(y);
  331.     int i, borrow = 0;
  332.  
  333.     if (len1 < len2) {
  334.     for (i = 0; i < len1; i++) {
  335.         int sum = digits1[i] - digits2[i] - borrow;
  336.         result[i] = sum & DIGIT_MASK;
  337.         borrow = (sum >> DIGIT_BITS) & 1;
  338.     }
  339.     for (i = len1; i < len2; i++) {
  340.         int sum = pad1 - digits2[i] - borrow;
  341.         result[i] = sum & DIGIT_MASK;
  342.         borrow = (sum >> DIGIT_BITS) & 1;
  343.     }
  344.     }
  345.     else {
  346.     for (i = 0; i < len2; i++) {
  347.         int sum = digits1[i] - digits2[i] - borrow;
  348.         result[i] = sum & DIGIT_MASK;
  349.         borrow = (sum >> DIGIT_BITS) & 1;
  350.     }
  351.     for (i = len2; i < len1; i++) {
  352.         int sum = digits1[i] - pad2 - borrow;
  353.         result[i] = sum & DIGIT_MASK;
  354.         borrow = (sum >> DIGIT_BITS) & 1;
  355.     }
  356.     }
  357.     result[length - 1] = (pad1 - pad2 - borrow) & DIGIT_MASK;
  358.     normalize_bignum(res, length);
  359. /*
  360.     printf("subracting "); dump_bignum(x, BIGNUM(x)->length);
  361.     printf(" and "); dump_bignum(y, BIGNUM(y)->length);
  362.     printf(" is "); dump_bignum(res, BIGNUM(res)->length); printf("\n");
  363. */
  364.     return res;
  365. }
  366.  
  367. obj_t negate_bignum(obj_t x)
  368. {
  369.     int len = BIGNUM(x)->length;
  370.     int length = len + 1;
  371.     obj_t res = alloc_bignum(length);
  372.     digit_t *digits = BIGNUM(x)->digits;
  373.     digit_t *result = BIGNUM(res)->digits;
  374.     int pad = PAD(x);
  375.     int i;
  376.     int borrow = 0;
  377.  
  378.     for (i = 0; i < len; i++) {
  379.     int sum = 0 - digits[i] - borrow;
  380.     result[i] = sum & DIGIT_MASK;
  381.     borrow = (sum >> DIGIT_BITS) & 1;
  382.     }
  383.     result[length - 1] = (0 - pad - borrow) & DIGIT_MASK;
  384.     normalize_bignum(res, length);
  385. /*
  386.     printf("negating "); dump_bignum(x, BIGNUM(x)->length);
  387.     printf(" is "); dump_bignum(res, BIGNUM(res)->length); printf("\n");
  388. */
  389.     return res;
  390. }
  391.  
  392. obj_t multiply_bignums(obj_t x, obj_t y)
  393. {
  394.     int len1 = BIGNUM(x)->length;
  395.     int len2 = BIGNUM(y)->length;
  396.     int length = len1 + len2;
  397.     obj_t res = alloc_bignum(length);
  398.     digit_t *result = BIGNUM(res)->digits;
  399.     digit_t *digits1 = BIGNUM(x)->digits;
  400.     digit_t *digits2 = BIGNUM(y)->digits;
  401.     int pad1 = PAD(x);
  402.     int pad2 = PAD(y);
  403.     int i, j;
  404.  
  405.     for (i = 0; i < length; i++)
  406.         result[i] = 0;
  407.     for (i = 0; i < len2; i++) {
  408.     int carry = 0;
  409.  
  410.     for (j = 0; (j < len1) && (j < length - i); j++) {
  411.         int product = digits1[j] * digits2[i] + result[i+j] + carry;
  412.         result[i+j] = product & DIGIT_MASK;
  413.         carry = product >> DIGIT_BITS;
  414.     }
  415.     for (j = len1; j < length - i; j++) {
  416.         int product = pad1 * digits2[i] + result[i+j] + carry;
  417.         result[i+j] = product & DIGIT_MASK;
  418.         carry = product >> DIGIT_BITS;
  419.     }
  420.     }
  421.     for (i = len2; i < length; i++) {
  422.     int carry = 0;
  423.  
  424.     for (j = 0; (j < len1) && (j < length - i); j++) {
  425.         int product = digits1[j] * pad2 + result[i+j] + carry;
  426.         result[i+j] = product & DIGIT_MASK;
  427.         carry = product >> DIGIT_BITS;
  428.     }
  429.     for (j = len1; j < length - i; j++) {
  430.         int product = pad1 * pad2 + result[i+j] + carry;
  431.         result[i+j] = product & DIGIT_MASK;
  432.         carry = product >> DIGIT_BITS;
  433.     }
  434.     }
  435.     normalize_bignum(res, length);
  436. /*
  437.     printf("multiplying "); dump_bignum(x, BIGNUM(x)->length);
  438.     printf(" and "); dump_bignum(y, BIGNUM(y)->length);
  439.     printf(" is "); dump_bignum(res, BIGNUM(res)->length); printf("\n");
  440. */
  441.     return res;
  442. }
  443.  
  444. static obj_t bignum_shift_left(obj_t bignum, int shift)
  445. {
  446.     int ndigits = shift / DIGIT_BITS;
  447.     int nbits = shift % DIGIT_BITS;
  448.     int len = BIGNUM(bignum)->length;
  449.     int length = len + ndigits + 1;
  450.     obj_t res = alloc_bignum(length);
  451.     digit_t *result = BIGNUM(res)->digits;
  452.     digit_t *digits = BIGNUM(bignum)->digits;
  453.     int pad = PAD(bignum);
  454.     int high_mask = (~0 << nbits) & DIGIT_MASK;
  455.     int low_mask = ~high_mask & DIGIT_MASK;
  456.     int i;
  457.  
  458.     for (i = 0; i < ndigits; i++)
  459.         result[i] = 0;
  460.  
  461.     if (nbits == 0) {
  462.     for (i = ndigits; i < length - 1; i++)
  463.         result[i] = digits[i - ndigits];
  464.     result[length - 1] = pad;
  465.     }
  466.     else {
  467.     result[ndigits] = (digits[0] << nbits) & high_mask;
  468.     for (i = ndigits + 1; i < length - 1; i++)
  469.         result[i] =
  470.           ((digits[i-ndigits] << nbits) & high_mask)
  471.         | ((digits[i-ndigits-1] >> (DIGIT_BITS - nbits)) & low_mask);
  472.     result[length - 1] =
  473.       (pad & high_mask)
  474.         | ((digits[len - 1] >> (DIGIT_BITS - nbits)) & low_mask);
  475.     }
  476.     normalize_bignum(res, length);
  477.  
  478.     return res;
  479. }
  480.  
  481. static obj_t bignum_shift_right(obj_t bignum, int shift)
  482. {
  483.     int ndigits = shift / DIGIT_BITS;
  484.     int nbits = shift % DIGIT_BITS;
  485.     int len = BIGNUM(bignum)->length;
  486.     int length = len - ndigits;
  487.     obj_t res = alloc_bignum(length);
  488.     digit_t *result = BIGNUM(res)->digits;
  489.     digit_t *digits = BIGNUM(bignum)->digits;
  490.     int pad = PAD(bignum);
  491.     int high_mask = (~0 << (DIGIT_BITS - nbits)) & DIGIT_MASK;
  492.     int low_mask = ~high_mask & DIGIT_MASK;
  493.     int i;
  494.  
  495.     if (length < 1) {
  496.         result[0] = pad;
  497.     normalize_bignum(res, 1);
  498.     return res;
  499.     }
  500.  
  501.     if (nbits == 0) {
  502.     for (i = 0; i < length; i++)
  503.         result[i] = digits[i + ndigits];
  504.     }
  505.     else {
  506.     for (i = 0; i < length - 1; i++)
  507.         result[i] =
  508.           ((digits[i+ndigits] >> nbits) & low_mask)
  509.         | ((digits[i+ndigits+1] << (DIGIT_BITS - nbits)) & high_mask);
  510.     result[length - 1] =
  511.       ((digits[len - 1] >> nbits) & low_mask)
  512.         | (pad & high_mask);
  513.     }
  514.     normalize_bignum(res, length);
  515. /*
  516.     printf("shifting "); dump_bignum(bignum, BIGNUM(bignum)->length);
  517.     printf(" by (%d, %d) is ", ndigits, nbits);
  518.     dump_bignum(res, BIGNUM(res)->length); printf("\n");
  519. */
  520.     return res;
  521. }
  522.  
  523. static void divide_by_digit(obj_t *quotient, int *remainder,
  524.                 obj_t dividend, digit_t divisor)
  525. {
  526.     int length = BIGNUM(dividend)->length;
  527.     digit_t *qptr, *dptr;
  528.     int i;
  529.     int d, q, r;
  530.  
  531.     *quotient = alloc_bignum(length);
  532.     qptr = BIGNUM(*quotient)->digits + length;
  533.     dptr = BIGNUM(dividend)->digits + length;
  534.  
  535.     r = 0;
  536.     for (i = 0; i < length; i++) {
  537.     d = (r << DIGIT_BITS) + *--dptr;
  538.     q = d / divisor;
  539.     r = d % divisor;
  540.     *--qptr = q;
  541.     }
  542.     normalize_bignum(*quotient, length);
  543.     *remainder = r;
  544. }
  545.  
  546. static int division_shift(obj_t divisor)
  547. {
  548.     int y1 = BIGNUM(divisor)->digits[BIGNUM(divisor)->length - 1];
  549.     int shift = 0;
  550.  
  551.     while (y1 > 0) {
  552.     y1 = y1 >> 1;
  553.     shift++;
  554.     }
  555.  
  556.     return (DIGIT_BITS - shift - 1);
  557. }
  558.  
  559. static int division_guess(int x1, int x2, int x3, int y1, int y2)
  560. {
  561.     int guess;
  562.     int x12 = (x1 << DIGIT_BITS) | x2;
  563.     int x123 = (x12 << DIGIT_BITS) | x3;
  564. /*
  565.     printf("starting guess with %02x %02x %02x / %02x %02x\n",
  566.        x1, x2, x3, y1, y2);
  567. */
  568.     if (x1 == y1)
  569.         guess = DIGIT_MASK;
  570.     else
  571.         guess = x12 / y1;
  572. /*
  573.     printf("initial guess is %x\n", guess);
  574. */
  575.     while (TRUE) {
  576. /*
  577.     printf("x is %x\n", x123);
  578.     printf("guess * y1 is %x\n", guess * y1 << DIGIT_BITS);
  579.     printf("guess * y2 is %x\n", guess * y2);
  580.     printf("x - guess * y1 is %x\n", x123 - ((guess * y1) << DIGIT_BITS));
  581. */
  582.     if (x123 - ((guess * y1) << DIGIT_BITS) < guess * y2)
  583.         guess--;
  584.     else
  585.         return guess;
  586. /*
  587.     printf("new guess is %x\n", guess);
  588. */
  589.     }
  590. }
  591.  
  592. static void divide(obj_t *quotient, obj_t *remainder,
  593.            obj_t dividend, obj_t divisor)
  594. {
  595.     obj_t x, y, q;
  596.     digit_t *result, *digits1, *digits2;
  597.     int len1, len2, length;
  598.     int shift = division_shift(divisor);
  599.     int i, j;
  600. /*
  601.     x = dividend; y = divisor;
  602.     printf("dividing "); dump_bignum(x, BIGNUM(x)->length);
  603.     printf(" by "); dump_bignum(y, BIGNUM(y)->length); printf("\n");
  604. */
  605.     x = bignum_shift_left(dividend, shift);
  606.     y = bignum_shift_left(divisor, shift);
  607.     x = extend_bignum(x, BIGNUM(x)->length + 1);
  608.  
  609.     len1 = BIGNUM(x)->length;
  610.     len2 = BIGNUM(y)->length;
  611.     length = len1 - len2;
  612.     digits1 = BIGNUM(x)->digits;
  613.     digits2 = BIGNUM(y)->digits;
  614.  
  615.     q = alloc_bignum(length);
  616.     result = BIGNUM(q)->digits;
  617.  
  618.     for (i = length - 1; i >= 0; i--) {
  619.     int x1 = digits1[i + len2];
  620.     int x2 = digits1[i + len2 - 1];
  621.     int x3 = digits1[i + len2 - 2];
  622.     int y1 = digits2[len2 - 1];
  623.     int y2 = digits2[len2 - 2];
  624.     int guess = division_guess(x1, x2, x3, y1, y2);
  625.     int value, carry, borrow;
  626. /*
  627.     printf("doing digit %d of quotient\n", i);
  628.     printf("guess is %d\n", guess);
  629. */
  630.     carry = borrow = 0;
  631.     for (j = 0; j < len2; j++) {
  632.         value = digits2[j] * guess + carry;
  633.         carry = value >> DIGIT_BITS;
  634.         value = digits1[i + j] - (value & DIGIT_MASK) - borrow;
  635.         digits1[i + j] = value & DIGIT_MASK;
  636.         borrow = (value >> DIGIT_BITS) & 1;
  637.     }
  638.     value = digits1[i + len2] - carry - borrow;
  639.     digits1[i + len2] = value & DIGIT_MASK;
  640.  
  641.     if (value & SIGN_MASK) {
  642.         guess--;
  643.         carry = 0;
  644.         for (j = 0; j < len2; j++) {
  645.         value = digits1[i + j] + digits2[j] + carry;
  646.         digits1[i + j] = value & DIGIT_MASK;
  647.         carry = value >> DIGIT_BITS;
  648.         }
  649.         value = digits1[i + len2] + carry;
  650.         digits1[i + len2] = value & DIGIT_MASK;
  651.     }
  652. /*
  653.     printf("remainder is "); dump_bignum(x, BIGNUM(x)->length); printf("\n");
  654. */
  655.     result[i] = guess;
  656.     }
  657.     normalize_bignum(x, len1);
  658.     normalize_bignum(q, length);
  659.     *remainder = bignum_shift_right(x, shift);
  660.     *quotient = q;
  661. }
  662.  
  663. static void bignum_divide(obj_t *q, obj_t *r, obj_t x, obj_t y)
  664. {
  665.     int len1, len2;
  666.     digit_t *digits1, *digits2;
  667.     boolean xneg = FALSE;
  668.     boolean yneg = FALSE;
  669.  
  670.     if (ZEROP(y))
  671.         error("Division by zero");
  672.  
  673.     if (SIGN(x)) {
  674.         x = negate_bignum(x);
  675.     xneg = TRUE;
  676.     }
  677.     if (SIGN(y)) {
  678.         y = negate_bignum(y);
  679.     yneg = TRUE;
  680.     }
  681.  
  682.     len1 = BIGNUM(x)->length;
  683.     len2 = BIGNUM(y)->length;
  684.     digits1 = BIGNUM(x)->digits;
  685.     digits2 = BIGNUM(y)->digits;
  686.  
  687.     if (len1 < len2
  688.     || (len1 == len2 && digits1[len1 - 1] < digits2[len2 - 1])) {
  689.     *q = make_bignum(0);
  690.     *r = x;
  691.     }
  692.     else if (len2 == 1) {
  693.     int r_value;
  694.     divide_by_digit(q, &r_value, x, digits2[0]);
  695.     *r = make_bignum(r_value);
  696.     }
  697.     else {
  698.     divide(q, r, x, y);
  699.     }
  700.  
  701.     if (xneg != yneg)
  702.         *q = negate_bignum(*q);
  703.     if (xneg)
  704.         *r = negate_bignum(*r);
  705. }
  706.  
  707. static void print_bignum_aux(obj_t bignum, int radix)
  708. {
  709.     int remainder;
  710.     obj_t quotient;
  711.  
  712.     divide_by_digit("ient, &remainder, bignum, radix);
  713.     if (!ZEROP(quotient))
  714.     print_bignum_aux(quotient, radix);
  715.     if (remainder < 10)
  716.     putchar('0' + remainder);
  717.     else
  718.     putchar('a' + remainder - 10);
  719. }
  720.  
  721. void print_bignum(obj_t bignum, int radix)
  722. {
  723.     if (SIGN(bignum)) {
  724.     putchar('-');
  725.     bignum = negate_bignum(bignum);
  726.     }
  727.  
  728.     print_bignum_aux(bignum, radix);
  729. }
  730.  
  731.  
  732. /* id? */
  733.  
  734. boolean idp(obj_t x, obj_t y)
  735. {
  736.     obj_t x_class, y_class;
  737.  
  738.     if (x == y)
  739.     return TRUE;
  740.  
  741.     if (obj_is_fixnum(x) || obj_is_fixnum(y))
  742.     return FALSE;
  743.  
  744.     x_class = obj_ptr(struct object *, x)->class;
  745.     y_class = obj_ptr(struct object *, y)->class;
  746.  
  747.     if (x_class != y_class)
  748.     return FALSE;
  749.  
  750.     if (x_class == obj_BignumClass)
  751.         return (compare_bignums(x, y) == 0);
  752.  
  753.     if (x_class == obj_RatioClass)
  754.     return (idp(RATIO(x)->numerator, RATIO(y)->numerator)
  755.         && idp(RATIO(x)->denominator, RATIO(y)->denominator));
  756.  
  757.     if (x_class == obj_SingleFloatClass)
  758.     return single_value(x) == single_value(y);
  759.  
  760.     if (x_class == obj_DoubleFloatClass)
  761.     return double_value(x) == double_value(y);
  762.  
  763.     if (x_class == obj_ExtendedFloatClass)
  764.     return extended_value(x) == extended_value(y);
  765.  
  766.     return FALSE;
  767. }
  768.  
  769. static obj_t dylan_idp(obj_t this, obj_t that)
  770. {
  771.     if (idp(this, that))
  772.     return obj_True;
  773.     else
  774.     return obj_False;
  775. }
  776.  
  777.  
  778. /* Printer support. */
  779.  
  780. static void print_fixnum(obj_t fixnum)
  781. {
  782.     printf("%ld", fixnum_value(fixnum));
  783. }
  784.  
  785. static void print_bignum_object(obj_t bignum)
  786. {
  787.     printf("#e");
  788.     print_bignum(bignum, 10);
  789. }
  790.  
  791. static void print_ratio(obj_t ratio)
  792. {
  793.     format("%d/%d", RATIO(ratio)->numerator, RATIO(ratio)->denominator);
  794. }
  795.  
  796. static void print_sf(obj_t sf)
  797. {
  798.     printf("%#g", single_value(sf));
  799. }
  800.  
  801. static void change_exponent_marker(char *ptr, int marker)
  802. {
  803.     while (*ptr != '\0' && *ptr != 'e' && *ptr != 'E')
  804.     ptr++;
  805.     if (*ptr == '\0') {
  806.     ptr[0] = marker;
  807.     ptr[1] = '0';
  808.     ptr[2] = '\0';
  809.     }
  810.     else
  811.     ptr[0] = marker;
  812. }
  813.  
  814. static void print_df(obj_t df)
  815. {
  816.     char buffer[64];
  817.  
  818.     sprintf(buffer, "%#g", double_value(df));
  819.     change_exponent_marker(buffer, 'd');
  820.     printf("%s", buffer);
  821. }
  822.  
  823. static void print_xf(obj_t xf)
  824. {
  825.     char buffer[64];
  826.  
  827.     sprintf(buffer, "%#g", (double)extended_value(xf));
  828.     change_exponent_marker(buffer, 'x');
  829.     printf("%s", buffer);
  830. }
  831.  
  832.  
  833. /* Dylan Routines -- Fixed Integers */
  834.  
  835. static obj_t dylan_fi_negative(obj_t x)
  836. {
  837.     return make_fixnum(-fixnum_value(x));
  838. }
  839.  
  840. static obj_t dylan_fi_fi_plus(obj_t x, obj_t y)
  841. {
  842.     return make_fixnum(fixnum_value(x) + fixnum_value(y));
  843. }
  844.  
  845. static obj_t dylan_fi_fi_minus(obj_t x, obj_t y)
  846. {
  847.     return make_fixnum(fixnum_value(x) - fixnum_value(y));
  848. }
  849.  
  850. static obj_t dylan_fi_fi_times(obj_t x, obj_t y)
  851. {
  852.     return make_fixnum(fixnum_value(x) * fixnum_value(y));
  853. }
  854.  
  855. static void dylan_fi_fi_trunc(obj_t self, struct thread *thread, obj_t *args)
  856. {
  857.     obj_t *old_sp = args - 1;
  858.     int x = fixnum_value(args[0]);
  859.     int y = fixnum_value(args[1]);
  860.  
  861.     if (y == 0)
  862.     error("Division by zero");
  863.     else {
  864.     int q = x / y;
  865.     int r = x % y;
  866.  
  867.     /* The remainder is supposed to have the same sign as the dividend. */
  868.     if (r != 0 && (r ^ x) < 0) {
  869.         r -= y;
  870.         q++;
  871.     }
  872.         
  873.     thread->sp = old_sp + 2;
  874.  
  875.     old_sp[0] = make_fixnum(q);
  876.     old_sp[1] = make_fixnum(r);
  877.     
  878.     do_return(thread, old_sp, old_sp);
  879.     }
  880. }
  881.  
  882. static void dylan_fi_fi_floor(obj_t self, struct thread *thread, obj_t *args)
  883. {
  884.     obj_t *old_sp = args - 1;
  885.     int x = fixnum_value(args[0]);
  886.     int y = fixnum_value(args[1]);
  887.  
  888.     if (y == 0)
  889.     error("Division by zero");
  890.     else {
  891.     int q = x / y;
  892.     int r = x % y;
  893.  
  894.     /* The remainder is supposed to be the same sign as the divisor. */
  895.     if (r != 0 && (r ^ y) < 0) {
  896.         r += y;
  897.         q--;
  898.     }
  899.  
  900.     thread->sp = old_sp + 2;
  901.  
  902.     old_sp[0] = make_fixnum(q);
  903.     old_sp[1] = make_fixnum(r);
  904.     
  905.     do_return(thread, old_sp, old_sp);
  906.     }
  907. }
  908.  
  909. static void dylan_fi_fi_ceil(obj_t self, struct thread *thread, obj_t *args)
  910. {
  911.     obj_t *old_sp = args - 1;
  912.     int x = fixnum_value(args[0]);
  913.     int y = fixnum_value(args[1]);
  914.  
  915.     if (y == 0)
  916.     error("Division by zero");
  917.     else {
  918.     int q = x / y;
  919.     int r = x % y;
  920.  
  921.     /* The remainder is supposed to be the opposite sign from */
  922.     /* the divisor.  */
  923.     if (r != 0 && (r ^ y) >= 0) {
  924.         r -= y;
  925.         q++;
  926.     }
  927.  
  928.     thread->sp = old_sp + 2;
  929.  
  930.     old_sp[0] = make_fixnum(q);
  931.     old_sp[1] = make_fixnum(r);
  932.     
  933.     do_return(thread, old_sp, old_sp);
  934.     }
  935. }
  936.  
  937. static void dylan_fi_fi_round(obj_t self, struct thread *thread, obj_t *args)
  938. {
  939.     obj_t *old_sp = args - 1;
  940.     int x = fixnum_value(args[0]);
  941.     int y = fixnum_value(args[1]);
  942.  
  943.     if (y == 0)
  944.     error("Division by zero");
  945.     else {
  946.     int q = x / y;
  947.     int r = x % y;
  948.  
  949.     if (r != 0) {
  950.         /* The remainder should be smaller (i.e. closer to zero) than */
  951.         /* half the divisor. */
  952.         if (y > 0) {
  953.         int limit = y >> 1;
  954.         if (r > limit || (r == limit && (q & 1))) {
  955.             /* r is too large. */
  956.             r -= y;
  957.             q++;
  958.         }
  959.         else if (r < -limit || (r == -limit && (q & 1))) {
  960.             /* r is too small */
  961.             r += y;
  962.             q--;
  963.         }
  964.         }
  965.         else {
  966.         int limit = -y >> 1;
  967.         if (r > limit || (r == limit && (q & 1))) {
  968.             /* r is too large. */
  969.             r += y;  /* note: y is negative. */
  970.             q--;
  971.         }
  972.         else if (r < -limit || (r == -limit && (q & 1))) {
  973.             /* r is too small */
  974.             r -= y;  /* note: y is negative. */
  975.             q++;
  976.         }
  977.         }
  978.     }
  979.  
  980.     thread->sp = old_sp + 2;
  981.  
  982.     old_sp[0] = make_fixnum(q);
  983.     old_sp[1] = make_fixnum(r);
  984.     
  985.     do_return(thread, old_sp, old_sp);
  986.     }
  987. }
  988.  
  989. static obj_t dylan_fi_fi_less(obj_t x, obj_t y)
  990. {
  991.     if (fixnum_value(x) < fixnum_value(y))
  992.     return obj_True;
  993.     else
  994.     return obj_False;
  995. }
  996.  
  997. static obj_t dylan_fi_fi_equal(obj_t x, obj_t y)
  998. {
  999.     if (fixnum_value(x) == fixnum_value(y))
  1000.     return obj_True;
  1001.     else
  1002.     return obj_False;
  1003. }
  1004.  
  1005. static obj_t dylan_fi_ash(obj_t x, obj_t shift_obj)
  1006. {
  1007.     int shift = fixnum_value(shift_obj);
  1008.  
  1009.     if (shift < 0)
  1010.     return make_fixnum(fixnum_value(x) >> -shift);
  1011.     else
  1012.     return make_fixnum(fixnum_value(x) << shift);
  1013. }
  1014.  
  1015. static obj_t dylan_fi_fi_logand(obj_t x, obj_t y)
  1016. {
  1017.     return make_fixnum(fixnum_value(x) & fixnum_value(y));
  1018. }
  1019.  
  1020. static obj_t dylan_fi_logbitp(obj_t index, obj_t x)
  1021. {
  1022.     if (fixnum_value(x) & (1 << fixnum_value(index)))
  1023.     return obj_True;
  1024.     else
  1025.     return obj_False;
  1026. }
  1027.  
  1028. static obj_t dylan_fi_fi_logior(obj_t x, obj_t y)
  1029. {
  1030.     return make_fixnum(fixnum_value(x) | fixnum_value(y));
  1031. }
  1032.  
  1033. static obj_t dylan_fi_lognot(obj_t x)
  1034. {
  1035.     return make_fixnum(~fixnum_value(x));
  1036. }
  1037.  
  1038. static obj_t dylan_fi_fi_logxor(obj_t x, obj_t y)
  1039. {
  1040.     return make_fixnum(fixnum_value(x) ^ fixnum_value(y));
  1041. }
  1042.  
  1043.  
  1044. /* Dylan Routines -- Extended Integers */
  1045.  
  1046. static obj_t dylan_ei_ei_equal(obj_t x, obj_t y)
  1047. {
  1048.     if (compare_bignums(x, y) == 0)
  1049.     return obj_True;
  1050.     else
  1051.     return obj_False;
  1052. }
  1053.  
  1054. static obj_t dylan_ei_ei_less(obj_t x, obj_t y)
  1055. {
  1056.     if (compare_bignums(x, y) < 0)
  1057.         return obj_True;
  1058.     else
  1059.         return obj_False;
  1060. }
  1061.  
  1062. static void dylan_ei_ei_floor(obj_t self, struct thread *thread, obj_t *args)
  1063. {
  1064.     obj_t *old_sp = args - 1;
  1065.     obj_t x = args[0];
  1066.     obj_t y = args[1];
  1067.     obj_t q, r;
  1068.  
  1069.     bignum_divide(&q, &r, x, y);
  1070.  
  1071.     if (! ZEROP(r)) {
  1072.     if (SIGN(r) != SIGN(y)) {
  1073.         r = add_bignums(r, y);
  1074.         q = subtract_bignums(q, make_bignum(1));
  1075.     }
  1076.     }
  1077.  
  1078.     thread->sp = old_sp + 2;
  1079.     old_sp[0] = q;
  1080.     old_sp[1] = r;
  1081.  
  1082.     do_return(thread, old_sp, old_sp);
  1083. }
  1084.  
  1085. static void dylan_ei_ei_ceil(obj_t self, struct thread *thread, obj_t *args)
  1086. {
  1087.     obj_t *old_sp = args - 1;
  1088.     obj_t x = args[0];
  1089.     obj_t y = args[1];
  1090.     obj_t q, r;
  1091.  
  1092.     bignum_divide(&q, &r, x, y);
  1093.  
  1094.     if (! ZEROP(r)) {
  1095.     if (SIGN(r) == SIGN(x)) {
  1096.         r = subtract_bignums(r, y);
  1097.         q = add_bignums(q, make_bignum(1));
  1098.     }
  1099.     }
  1100.  
  1101.     thread->sp = old_sp + 2;
  1102.     old_sp[0] = q;
  1103.     old_sp[1] = r;
  1104.  
  1105.     do_return(thread, old_sp, old_sp);
  1106. }
  1107.  
  1108. static void dylan_ei_ei_trunc(obj_t self, struct thread *thread, obj_t *args)
  1109. {
  1110.     obj_t *old_sp = args - 1;
  1111.     obj_t x = args[0];
  1112.     obj_t y = args[1];
  1113.     obj_t q, r;
  1114.  
  1115.     bignum_divide(&q, &r, x, y);
  1116.  
  1117.     if (! ZEROP(r)) {
  1118.     if (SIGN(r) != SIGN(x)) {
  1119.         r = subtract_bignums(r, y);
  1120.         q = add_bignums(q, make_bignum(1));
  1121.     }
  1122.     }
  1123.  
  1124.     thread->sp = old_sp + 2;
  1125.     old_sp[0] = q;
  1126.     old_sp[1] = r;
  1127.  
  1128.     do_return(thread, old_sp, old_sp);
  1129. }
  1130.  
  1131. static void dylan_ei_ei_round(obj_t self, struct thread *thread, obj_t *args)
  1132. {
  1133.     obj_t *old_sp = args - 1;
  1134.     obj_t x = args[0];
  1135.     obj_t y = args[1];
  1136.     obj_t q, r;
  1137.  
  1138.     bignum_divide(&q, &r, x, y);
  1139.  
  1140.     if (! ZEROP(r)) {
  1141.     if (SIGN(r) != SIGN(x)) {
  1142.         r = subtract_bignums(r, y);
  1143.         q = add_bignums(q, make_bignum(1));
  1144.     }
  1145.     }
  1146.  
  1147.     thread->sp = old_sp + 2;
  1148.     old_sp[0] = q;
  1149.     old_sp[1] = r;
  1150.  
  1151.     do_return(thread, old_sp, old_sp);
  1152. }
  1153.  
  1154. static obj_t dylan_ei_ei_logior(obj_t x, obj_t y)
  1155. {
  1156.     int len1 = BIGNUM(x)->length;
  1157.     int len2 = BIGNUM(y)->length;
  1158.     int length = MAX(len1, len2);
  1159.     obj_t res = alloc_bignum(length);
  1160.     digit_t *result = BIGNUM(res)->digits;
  1161.     digit_t *digits1 = BIGNUM(x)->digits;
  1162.     digit_t *digits2 = BIGNUM(y)->digits;
  1163.     int pad1 = PAD(x);
  1164.     int pad2 = PAD(y);
  1165.     int i;
  1166.  
  1167.     if (len1 < len2) {
  1168.     for (i = 0; i < len1; i++)
  1169.         result[i] = digits1[i] | digits2[i];
  1170.     for (i = len1; i < length; i++)
  1171.         result[i] = pad1 | digits2[i];
  1172.     }
  1173.     else {
  1174.     for (i = 0; i < len2; i++)
  1175.         result[i] = digits1[i] | digits2[i];
  1176.     for (i = len2; i < length; i++)
  1177.         result[i] = digits1[i] | pad2;
  1178.     }
  1179.     normalize_bignum(res, length);
  1180.  
  1181.     return res;
  1182. }
  1183.  
  1184. static obj_t dylan_ei_ei_logxor(obj_t x, obj_t y)
  1185. {
  1186.     int len1 = BIGNUM(x)->length;
  1187.     int len2 = BIGNUM(y)->length;
  1188.     int length = MAX(len1, len2);
  1189.     obj_t res = alloc_bignum(length);
  1190.     digit_t *result = BIGNUM(res)->digits;
  1191.     digit_t *digits1 = BIGNUM(x)->digits;
  1192.     digit_t *digits2 = BIGNUM(y)->digits;
  1193.     int pad1 = PAD(x);
  1194.     int pad2 = PAD(y);
  1195.     int i;
  1196.  
  1197.     if (len1 < len2) {
  1198.     for (i = 0; i < len1; i++)
  1199.         result[i] = digits1[i] ^ digits2[i];
  1200.     for (i = len1; i < length; i++)
  1201.         result[i] = pad1 ^ digits2[i];
  1202.     }
  1203.     else {
  1204.     for (i = 0; i < len2; i++)
  1205.         result[i] = digits1[i] ^ digits2[i];
  1206.     for (i = len2; i < length; i++)
  1207.         result[i] = digits1[i] ^ pad2;
  1208.     }
  1209.     normalize_bignum(res, length);
  1210.  
  1211.     return res;
  1212. }
  1213.  
  1214. static obj_t dylan_ei_ei_logand(obj_t x, obj_t y)
  1215. {
  1216.     int len1 = BIGNUM(x)->length;
  1217.     int len2 = BIGNUM(y)->length;
  1218.     int length = MAX(len1, len2);
  1219.     obj_t res = alloc_bignum(length);
  1220.     digit_t *result = BIGNUM(res)->digits;
  1221.     digit_t *digits1 = BIGNUM(x)->digits;
  1222.     digit_t *digits2 = BIGNUM(y)->digits;
  1223.     int pad1 = PAD(x);
  1224.     int pad2 = PAD(y);
  1225.     int i;
  1226.  
  1227.     if (len1 < len2) {
  1228.     for (i = 0; i < len1; i++)
  1229.         result[i] = digits1[i] & digits2[i];
  1230.     for (i = len1; i < length; i++)
  1231.         result[i] = pad1 & digits2[i];
  1232.     }
  1233.     else {
  1234.     for (i = 0; i < len2; i++)
  1235.         result[i] = digits1[i] & digits2[i];
  1236.     for (i = len2; i < length; i++)
  1237.         result[i] = digits1[i] & pad2;
  1238.     }
  1239.     normalize_bignum(res, length);
  1240.  
  1241.     return res;
  1242. }
  1243.  
  1244. static obj_t dylan_ei_lognot(obj_t x)
  1245. {
  1246.     int length = BIGNUM(x)->length;
  1247.     obj_t res = alloc_bignum(length);
  1248.     digit_t *result = BIGNUM(res)->digits;
  1249.     digit_t *digits = BIGNUM(x)->digits;
  1250.     int i;
  1251.  
  1252.     for (i = 0; i < length; i++)
  1253.     result[i] = ~digits[i];
  1254.     normalize_bignum(res, length);
  1255.  
  1256.     return res;
  1257. }
  1258.  
  1259. static obj_t dylan_ei_logbitp(obj_t i, obj_t x)
  1260. {
  1261.     int index = fixnum_value(i);
  1262.     int digit = index / DIGIT_BITS;
  1263.     int bit = index % DIGIT_BITS;
  1264.  
  1265.     if (index < 0)
  1266.         error("Can't look at bit %d", index);
  1267.     if (digit >= BIGNUM(x)->length) {
  1268.     if (SIGN(x))
  1269.         return obj_True;
  1270.     else
  1271.         return obj_False;
  1272.     }
  1273.  
  1274.     if (BIGNUM(x)->digits[digit] & (1 << bit))
  1275.         return obj_True;
  1276.     else
  1277.         return obj_False;
  1278. }
  1279.  
  1280. static obj_t dylan_ei_ash(obj_t x, obj_t shift_count)
  1281. {
  1282.     int shift = fixnum_value(shift_count);
  1283.  
  1284.     if (shift > 0)
  1285.         return bignum_shift_left(x, shift);
  1286.     else
  1287.         return bignum_shift_right(x, -shift);
  1288. }
  1289.  
  1290.  
  1291. /* Dylan Routines -- Ratios */
  1292.  
  1293. static obj_t dylan_numerator(obj_t ratio)
  1294. {
  1295.     return (RATIO(ratio)->numerator);
  1296. }
  1297.  
  1298. static obj_t dylan_denominator(obj_t ratio)
  1299. {
  1300.     return (RATIO(ratio)->denominator);
  1301. }
  1302.  
  1303. static obj_t dylan_numerator_setter(obj_t value, obj_t ratio)
  1304. {
  1305.     return (RATIO(ratio)->numerator = value);
  1306. }
  1307.  
  1308. static obj_t dylan_denominator_setter(obj_t value, obj_t ratio)
  1309. {
  1310.     return (RATIO(ratio)->denominator = value);
  1311. }
  1312.  
  1313.  
  1314. /* Dylan Routines -- Single Float */
  1315.  
  1316. static obj_t dylan_sf_negative(obj_t x)
  1317. {
  1318.     return make_single(-single_value(x));
  1319. }
  1320.  
  1321. static obj_t dylan_sf_sf_plus(obj_t x, obj_t y)
  1322. {
  1323.     return make_single(single_value(x) + single_value(y));
  1324. }
  1325.  
  1326. static obj_t dylan_sf_sf_minus(obj_t x, obj_t y)
  1327. {
  1328.     return make_single(single_value(x) - single_value(y));
  1329. }
  1330.  
  1331. static obj_t dylan_sf_sf_times(obj_t x, obj_t y)
  1332. {
  1333.     return make_single(single_value(x) * single_value(y));
  1334. }
  1335.  
  1336. static obj_t dylan_sf_sf_divide(obj_t x, obj_t y)
  1337. {
  1338.     return make_single(single_value(x) / single_value(y));
  1339. }
  1340.  
  1341. static void dylan_sf_trunc(obj_t self, struct thread *thread, obj_t *args)
  1342. {
  1343.     obj_t *old_sp = args - 1;
  1344.     float x = single_value(args[0]);
  1345.     int res = x < 0 ? ceil(x) : floor(x);
  1346.  
  1347.     thread->sp = old_sp + 2;
  1348.  
  1349.     old_sp[0] = make_fixnum(res);
  1350.     old_sp[1] = make_single(x - res);
  1351.  
  1352.     do_return(thread, old_sp, old_sp);
  1353. }
  1354.  
  1355. static void dylan_sf_floor(obj_t self, struct thread *thread, obj_t *args)
  1356. {
  1357.     obj_t *old_sp = args - 1;
  1358.     float x = single_value(args[0]);
  1359.     int res = floor(x);
  1360.  
  1361.     thread->sp = old_sp + 2;
  1362.  
  1363.     old_sp[0] = make_fixnum(res);
  1364.     old_sp[1] = make_single(x - res);
  1365.  
  1366.     do_return(thread, old_sp, old_sp);
  1367. }
  1368.  
  1369. static void dylan_sf_ceil(obj_t self, struct thread *thread, obj_t *args)
  1370. {
  1371.     obj_t *old_sp = args - 1;
  1372.     float x = single_value(args[0]);
  1373.     int res = ceil(x);
  1374.  
  1375.     thread->sp = old_sp + 2;
  1376.  
  1377.     old_sp[0] = make_fixnum(res);
  1378.     old_sp[1] = make_single(x - res);
  1379.  
  1380.     do_return(thread, old_sp, old_sp);
  1381. }
  1382.  
  1383. static void dylan_sf_round(obj_t self, struct thread *thread, obj_t *args)
  1384. {
  1385.     obj_t *old_sp = args - 1;
  1386.     float x = single_value(args[0]);
  1387.     int res = rint(x);
  1388.  
  1389.     thread->sp = old_sp + 2;
  1390.  
  1391.     old_sp[0] = make_fixnum(res);
  1392.     old_sp[1] = make_single(x - res);
  1393.  
  1394.     do_return(thread, old_sp, old_sp);
  1395. }
  1396.  
  1397. static obj_t dylan_sf_sf_less(obj_t x, obj_t y)
  1398. {
  1399.     if (single_value(x) < single_value(y))
  1400.     return obj_True;
  1401.     else
  1402.     return obj_False;
  1403. }
  1404.  
  1405. static obj_t dylan_sf_sf_less_or_eql(obj_t x, obj_t y)
  1406. {
  1407.     if (single_value(x) <= single_value(y))
  1408.     return obj_True;
  1409.     else
  1410.     return obj_False;
  1411. }
  1412.  
  1413. static obj_t dylan_sf_sf_equal(obj_t x, obj_t y)
  1414. {
  1415.     if (single_value(x) == single_value(y))
  1416.     return obj_True;
  1417.     else
  1418.     return obj_False;
  1419. }
  1420.  
  1421. static obj_t dylan_sf_sf_not_equal(obj_t x, obj_t y)
  1422. {
  1423.     if (single_value(x) != single_value(y))
  1424.     return obj_True;
  1425.     else
  1426.     return obj_False;
  1427. }
  1428.  
  1429.  
  1430. /* Dylan Routines -- Double Float */
  1431.  
  1432. static obj_t dylan_df_negative(obj_t x)
  1433. {
  1434.     return make_double(-double_value(x));
  1435. }
  1436.  
  1437. static obj_t dylan_df_df_plus(obj_t x, obj_t y)
  1438. {
  1439.     return make_double(double_value(x) + double_value(y));
  1440. }
  1441.  
  1442. static obj_t dylan_df_df_minus(obj_t x, obj_t y)
  1443. {
  1444.     return make_double(double_value(x) - double_value(y));
  1445. }
  1446.  
  1447. static obj_t dylan_df_df_times(obj_t x, obj_t y)
  1448. {
  1449.     return make_double(double_value(x) * double_value(y));
  1450. }
  1451.  
  1452. static obj_t dylan_df_df_divide(obj_t x, obj_t y)
  1453. {
  1454.     return make_double(double_value(x) / double_value(y));
  1455. }
  1456.  
  1457. static void dylan_df_trunc(obj_t self, struct thread *thread, obj_t *args)
  1458. {
  1459.     obj_t *old_sp = args - 1;
  1460.     double x = double_value(args[0]);
  1461.     int res = x < 0 ? ceil(x) : floor(x);
  1462.  
  1463.     thread->sp = old_sp + 2;
  1464.  
  1465.     old_sp[0] = make_fixnum(res);
  1466.     old_sp[1] = make_double(x - res);
  1467.  
  1468.     do_return(thread, old_sp, old_sp);
  1469. }
  1470.  
  1471. static void dylan_df_floor(obj_t self, struct thread *thread, obj_t *args)
  1472. {
  1473.     obj_t *old_sp = args - 1;
  1474.     double x = double_value(args[0]);
  1475.     int res = floor(x);
  1476.  
  1477.     thread->sp = old_sp + 2;
  1478.  
  1479.     old_sp[0] = make_fixnum(res);
  1480.     old_sp[1] = make_double(x - res);
  1481.  
  1482.     do_return(thread, old_sp, old_sp);
  1483. }
  1484.  
  1485. static void dylan_df_ceil(obj_t self, struct thread *thread, obj_t *args)
  1486. {
  1487.     obj_t *old_sp = args - 1;
  1488.     double x = double_value(args[0]);
  1489.     int res = ceil(x);
  1490.  
  1491.     thread->sp = old_sp + 2;
  1492.  
  1493.     old_sp[0] = make_fixnum(res);
  1494.     old_sp[1] = make_double(x - res);
  1495.  
  1496.     do_return(thread, old_sp, old_sp);
  1497. }
  1498.  
  1499. static void dylan_df_round(obj_t self, struct thread *thread, obj_t *args)
  1500. {
  1501.     obj_t *old_sp = args - 1;
  1502.     double x = double_value(args[0]);
  1503.     int res = rint(x);
  1504.  
  1505.     thread->sp = old_sp + 2;
  1506.  
  1507.     old_sp[0] = make_fixnum(res);
  1508.     old_sp[1] = make_double(x - res);
  1509.  
  1510.     do_return(thread, old_sp, old_sp);
  1511. }
  1512.  
  1513. static obj_t dylan_df_df_less(obj_t x, obj_t y)
  1514. {
  1515.     if (double_value(x) < double_value(y))
  1516.     return obj_True;
  1517.     else
  1518.     return obj_False;
  1519. }
  1520.  
  1521. static obj_t dylan_df_df_less_or_eql(obj_t x, obj_t y)
  1522. {
  1523.     if (double_value(x) <= double_value(y))
  1524.     return obj_True;
  1525.     else
  1526.     return obj_False;
  1527. }
  1528.  
  1529. static obj_t dylan_df_df_equal(obj_t x, obj_t y)
  1530. {
  1531.     if (double_value(x) == double_value(y))
  1532.     return obj_True;
  1533.     else
  1534.     return obj_False;
  1535. }
  1536.  
  1537. static obj_t dylan_df_df_not_equal(obj_t x, obj_t y)
  1538. {
  1539.     if (double_value(x) != double_value(y))
  1540.     return obj_True;
  1541.     else
  1542.     return obj_False;
  1543. }
  1544.  
  1545.  
  1546. /* Dylan Routines -- Extended Float */
  1547.  
  1548. static obj_t dylan_xf_negative(obj_t x)
  1549. {
  1550.     return make_extended(-extended_value(x));
  1551. }
  1552.  
  1553. static obj_t dylan_xf_xf_plus(obj_t x, obj_t y)
  1554. {
  1555.     return make_extended(extended_value(x) + extended_value(y));
  1556. }
  1557.  
  1558. static obj_t dylan_xf_xf_minus(obj_t x, obj_t y)
  1559. {
  1560.     return make_extended(extended_value(x) - extended_value(y));
  1561. }
  1562.  
  1563. static obj_t dylan_xf_xf_times(obj_t x, obj_t y)
  1564. {
  1565.     return make_extended(extended_value(x) * extended_value(y));
  1566. }
  1567.  
  1568. static obj_t dylan_xf_xf_divide(obj_t x, obj_t y)
  1569. {
  1570.     return make_extended(extended_value(x) / extended_value(y));
  1571. }
  1572.  
  1573. static void dylan_xf_trunc(obj_t self, struct thread *thread, obj_t *args)
  1574. {
  1575.     obj_t *old_sp = args - 1;
  1576.     long double x = extended_value(args[0]);
  1577.     int res = x < 0 ? ceil(x) : floor(x);
  1578.  
  1579.     thread->sp = old_sp + 2;
  1580.  
  1581.     old_sp[0] = make_fixnum(res);
  1582.     old_sp[1] = make_extended(x - res);
  1583.  
  1584.     do_return(thread, old_sp, old_sp);
  1585. }
  1586.  
  1587. static void dylan_xf_floor(obj_t self, struct thread *thread, obj_t *args)
  1588. {
  1589.     obj_t *old_sp = args - 1;
  1590.     long double x = extended_value(args[0]);
  1591.     int res = floor(x);
  1592.  
  1593.     thread->sp = old_sp + 2;
  1594.  
  1595.     old_sp[0] = make_fixnum(res);
  1596.     old_sp[1] = make_extended(x - res);
  1597.  
  1598.     do_return(thread, old_sp, old_sp);
  1599. }
  1600.  
  1601. static void dylan_xf_ceil(obj_t self, struct thread *thread, obj_t *args)
  1602. {
  1603.     obj_t *old_sp = args - 1;
  1604.     long double x = extended_value(args[0]);
  1605.     int res = ceil(x);
  1606.  
  1607.     thread->sp = old_sp + 2;
  1608.  
  1609.     old_sp[0] = make_fixnum(res);
  1610.     old_sp[1] = make_extended(x - res);
  1611.  
  1612.     do_return(thread, old_sp, old_sp);
  1613. }
  1614.  
  1615. static void dylan_xf_round(obj_t self, struct thread *thread, obj_t *args)
  1616. {
  1617.     obj_t *old_sp = args - 1;
  1618.     long double x = extended_value(args[0]);
  1619.     int res = rint(x);
  1620.  
  1621.     thread->sp = old_sp + 2;
  1622.  
  1623.     old_sp[0] = make_fixnum(res);
  1624.     old_sp[1] = make_extended(x - res);
  1625.  
  1626.     do_return(thread, old_sp, old_sp);
  1627. }
  1628.  
  1629. static obj_t dylan_xf_xf_less(obj_t x, obj_t y)
  1630. {
  1631.     if (extended_value(x) < extended_value(y))
  1632.     return obj_True;
  1633.     else
  1634.     return obj_False;
  1635. }
  1636.  
  1637. static obj_t dylan_xf_xf_less_or_eql(obj_t x, obj_t y)
  1638. {
  1639.     if (extended_value(x) <= extended_value(y))
  1640.     return obj_True;
  1641.     else
  1642.     return obj_False;
  1643. }
  1644.  
  1645. static obj_t dylan_xf_xf_equal(obj_t x, obj_t y)
  1646. {
  1647.     if (extended_value(x) == extended_value(y))
  1648.     return obj_True;
  1649.     else
  1650.     return obj_False;
  1651. }
  1652.  
  1653. static obj_t dylan_xf_xf_not_equal(obj_t x, obj_t y)
  1654. {
  1655.     if (extended_value(x) != extended_value(y))
  1656.     return obj_True;
  1657.     else
  1658.     return obj_False;
  1659. }
  1660.  
  1661.  
  1662. /* Coercions */
  1663.  
  1664. static obj_t dylan_as_identity(obj_t class, obj_t thing)
  1665. {
  1666.     return thing;
  1667. }
  1668.  
  1669. static obj_t dylan_fi_as_ei(obj_t class, obj_t x)
  1670. {
  1671.     return make_bignum(fixnum_value(x));
  1672. }
  1673.  
  1674. static obj_t dylan_fi_as_sf(obj_t class, obj_t x)
  1675. {
  1676.     return make_single((float)fixnum_value(x));
  1677. }
  1678.  
  1679. static obj_t dylan_fi_as_df(obj_t class, obj_t x)
  1680. {
  1681.     return make_double((double)fixnum_value(x));
  1682. }
  1683.  
  1684. static obj_t dylan_fi_as_xf(obj_t class, obj_t x)
  1685. {
  1686.     return make_extended((long double)fixnum_value(x));
  1687. }
  1688.  
  1689. static obj_t dylan_ei_as_fi(obj_t class, obj_t x)
  1690. {
  1691.     int length = BIGNUM(x)->length;
  1692.     digit_t *digits = BIGNUM(x)->digits;
  1693.     int i;
  1694.     long res = 0;
  1695.  
  1696.     if (digits[length-1] & SIGN_MASK) {
  1697.     /* It is negative, make sure it is not too negative. */
  1698.     if (compare_bignums(x, as_bignum(MIN_FIXNUM)) < 0)
  1699.         error("Can't convert %= to <fixed-integer>", x);
  1700.     res = -1;
  1701.     }
  1702.     else {
  1703.     /* It is positive, make sure it is not too positive. */
  1704.     if (compare_bignums(x, as_bignum(MAX_FIXNUM)) > 0)
  1705.         error("Can't convert %= to <fixed-integer>", x);
  1706.     }
  1707.  
  1708.     for (i = length - 1; i >= 0; i--)
  1709.     res = (res << DIGIT_BITS) | digits[i];
  1710.     return make_fixnum(res);
  1711. }
  1712.  
  1713. static obj_t dylan_ei_as_sf(obj_t class, obj_t x)
  1714. {
  1715.     int length = BIGNUM(x)->length;
  1716.     digit_t *digits = BIGNUM(x)->digits;
  1717.     float res = 0;
  1718.     float base = (float) (1 << DIGIT_BITS);
  1719.     float place = 1;
  1720.     int i;
  1721.  
  1722.     for (i = 0; i < length; i++) {
  1723.     res += ((float) digits[i]) * place;
  1724.     place *= base;
  1725.     }
  1726.     return make_single(res);
  1727. }
  1728.  
  1729. static obj_t dylan_ei_as_df(obj_t class, obj_t x)
  1730. {
  1731.     int length = BIGNUM(x)->length;
  1732.     digit_t *digits = BIGNUM(x)->digits;
  1733.     double res = 0;
  1734.     double base = (double) (1 << DIGIT_BITS);
  1735.     double place = 1;
  1736.     int i;
  1737.  
  1738.     for (i = 0; i < length; i++) {
  1739.     res += ((double) digits[i]) * place;
  1740.     place *= base;
  1741.     }
  1742.     return make_double(res);
  1743. }
  1744.  
  1745. static obj_t dylan_ei_as_xf(obj_t class, obj_t x)
  1746. {
  1747.     int length = BIGNUM(x)->length;
  1748.     digit_t *digits = BIGNUM(x)->digits;
  1749.     long double res = 0;
  1750.     long double base = (long double) (1 << DIGIT_BITS);
  1751.     long double place = 1;
  1752.     int i;
  1753.  
  1754.     for (i = 0; i < length; i++) {
  1755.     res += ((long double) digits[i]) * place;
  1756.     place *= base;
  1757.     }
  1758.     return make_extended(res);
  1759. }
  1760.  
  1761. static obj_t dylan_sf_as_df(obj_t class, obj_t x)
  1762. {
  1763.     return make_double((double)single_value(x));
  1764. }
  1765.  
  1766. static obj_t dylan_sf_as_xf(obj_t class, obj_t x)
  1767. {
  1768.     return make_extended((long double)single_value(x));
  1769. }
  1770.  
  1771. static obj_t dylan_df_as_sf(obj_t class, obj_t x)
  1772. {
  1773.     return make_single((float)double_value(x));
  1774. }
  1775.  
  1776. static obj_t dylan_df_as_xf(obj_t class, obj_t x)
  1777. {
  1778.     return make_extended((long double)double_value(x));
  1779. }
  1780.  
  1781. static obj_t dylan_xf_as_sf(obj_t class, obj_t x)
  1782. {
  1783.     return make_single((float)extended_value(x));
  1784. }
  1785.  
  1786. static obj_t dylan_xf_as_df(obj_t class, obj_t x)
  1787. {
  1788.     return make_double((double)extended_value(x));
  1789. }
  1790.  
  1791.  
  1792.  
  1793. /* GC stuff. */
  1794.  
  1795. static int scav_bignum(struct object *ptr)
  1796. {
  1797.     int length = ((struct bignum *)ptr)->length;
  1798.     return (sizeof(struct bignum) + (length - 1) * sizeof(digit_t));
  1799. }
  1800.  
  1801. static obj_t trans_bignum(obj_t sf)
  1802. {
  1803.     int length = BIGNUM(sf)->length;
  1804.     return transport(sf, (sizeof(struct bignum)
  1805.               + (length - 1) * sizeof(digit_t)));
  1806. }
  1807.  
  1808. static int scav_ratio(struct object *ptr)
  1809. {
  1810.     struct ratio *ratio = (struct ratio *) ptr;
  1811.  
  1812.     scavenge(&ratio->numerator);
  1813.     scavenge(&ratio->denominator);
  1814.  
  1815.     return sizeof(struct ratio);
  1816. }
  1817.  
  1818. static obj_t trans_ratio(obj_t ratio)
  1819. {
  1820.     return transport(ratio, sizeof(struct ratio));
  1821. }
  1822.  
  1823. static int scav_sf(struct object *ptr)
  1824. {
  1825.     return sizeof(struct single_float);
  1826. }
  1827.  
  1828. static obj_t trans_sf(obj_t sf)
  1829. {
  1830.     return transport(sf, sizeof(struct single_float));
  1831. }
  1832.  
  1833. static int scav_df(struct object *ptr)
  1834. {
  1835.     return sizeof(struct double_float);
  1836. }
  1837.  
  1838. static obj_t trans_df(obj_t sf)
  1839. {
  1840.     return transport(sf, sizeof(struct double_float));
  1841. }
  1842.  
  1843. static int scav_xf(struct object *ptr)
  1844. {
  1845.     return sizeof(struct extended_float);
  1846. }
  1847.  
  1848. static obj_t trans_xf(obj_t sf)
  1849. {
  1850.     return transport(sf, sizeof(struct extended_float));
  1851. }
  1852.  
  1853. void scavenge_num_roots(void)
  1854. {
  1855.     scavenge(&obj_NumberClass);
  1856.     scavenge(&obj_ComplexClass);
  1857.     scavenge(&obj_RealClass);
  1858.     scavenge(&obj_RationalClass);
  1859.     scavenge(&obj_IntegerClass);
  1860.     scavenge(&obj_FixnumClass);
  1861.     scavenge(&obj_BignumClass);
  1862.     scavenge(&obj_RatioClass);
  1863.     scavenge(&obj_FloatClass);
  1864.     scavenge(&obj_SingleFloatClass);
  1865.     scavenge(&obj_DoubleFloatClass);
  1866.     scavenge(&obj_ExtendedFloatClass);
  1867. }
  1868.  
  1869.  
  1870. /* Init stuff. */
  1871.  
  1872. void make_num_classes(void)
  1873. {
  1874.     obj_NumberClass = make_abstract_class(FALSE);
  1875.     obj_ComplexClass = make_abstract_class(FALSE);
  1876.     obj_RealClass = make_abstract_class(TRUE);
  1877.     obj_RationalClass = make_abstract_class(TRUE);
  1878.     obj_IntegerClass = make_abstract_class(TRUE);
  1879.  
  1880.     /* isn't really abstract, but there arn't heap instances either */
  1881.  
  1882.     obj_FixnumClass = make_abstract_class(TRUE);
  1883.     obj_BignumClass = make_builtin_class(scav_bignum, trans_bignum);
  1884.     obj_RatioClass = make_builtin_class(scav_ratio, trans_ratio);
  1885.     obj_FloatClass = make_abstract_class(TRUE);
  1886.     obj_SingleFloatClass = make_builtin_class(scav_sf, trans_sf);
  1887.     obj_DoubleFloatClass = make_builtin_class(scav_df, trans_df);
  1888.     obj_ExtendedFloatClass = make_builtin_class(scav_xf, trans_xf);
  1889. }
  1890.  
  1891. void init_num_classes(void)
  1892. {
  1893.     init_builtin_class(obj_NumberClass, "<number>", obj_ObjectClass, NULL);
  1894.     init_builtin_class(obj_ComplexClass, "<complex>", obj_NumberClass, NULL);
  1895.     init_builtin_class(obj_RealClass, "<real>", obj_ComplexClass, NULL);
  1896.     init_builtin_class(obj_RationalClass, "<rational>", obj_RealClass, NULL);
  1897.     init_builtin_class(obj_IntegerClass, "<integer>", obj_RationalClass, NULL);
  1898.     init_builtin_class(obj_FixnumClass, "<fixed-integer>", obj_IntegerClass,
  1899.                NULL);
  1900.     def_printer(obj_FixnumClass, print_fixnum);
  1901.     init_builtin_class(obj_BignumClass, "<extended-integer>", obj_IntegerClass,
  1902.                NULL);
  1903.     def_printer(obj_BignumClass, print_bignum_object);
  1904.     init_builtin_class(obj_RatioClass, "<ratio>", obj_RationalClass, NULL);
  1905.     def_printer(obj_RatioClass, print_ratio);
  1906.     init_builtin_class(obj_FloatClass, "<float>", obj_RealClass, NULL);
  1907.     init_builtin_class(obj_SingleFloatClass, "<single-float>",
  1908.                obj_FloatClass, NULL);
  1909.     def_printer(obj_SingleFloatClass, print_sf);
  1910.     init_builtin_class(obj_DoubleFloatClass, "<double-float>",
  1911.                obj_FloatClass, NULL);
  1912.     def_printer(obj_DoubleFloatClass, print_df);
  1913.     init_builtin_class(obj_ExtendedFloatClass, "<extended-float>",
  1914.                obj_FloatClass, NULL);
  1915.     def_printer(obj_ExtendedFloatClass, print_xf);
  1916. }
  1917.  
  1918. void init_num_functions(void)
  1919. {
  1920.     obj_t fi = list1(obj_FixnumClass);
  1921.     obj_t ei = list1(obj_BignumClass);
  1922.     obj_t ratio = list1(obj_RatioClass);
  1923.     obj_t sf = list1(obj_SingleFloatClass);
  1924.     obj_t df = list1(obj_DoubleFloatClass);
  1925.     obj_t xf = list1(obj_ExtendedFloatClass);
  1926.     obj_t two_objs = list2(obj_ObjectClass, obj_ObjectClass);
  1927.     obj_t two_ints = list2(obj_IntegerClass, obj_IntegerClass);
  1928.     obj_t two_fis = list2(obj_FixnumClass, obj_FixnumClass);
  1929.     obj_t two_eis = list2(obj_BignumClass, obj_BignumClass);
  1930.     obj_t two_sfs = list2(obj_SingleFloatClass, obj_SingleFloatClass);
  1931.     obj_t two_dfs = list2(obj_DoubleFloatClass, obj_DoubleFloatClass);
  1932.     obj_t two_xfs = list2(obj_ExtendedFloatClass, obj_ExtendedFloatClass);
  1933.     obj_t int_and_real = list2(obj_IntegerClass, obj_RealClass);
  1934.     obj_t int_and_sf = list2(obj_IntegerClass, obj_SingleFloatClass);
  1935.     obj_t int_and_df = list2(obj_IntegerClass, obj_DoubleFloatClass);
  1936.     obj_t int_and_xf = list2(obj_IntegerClass, obj_ExtendedFloatClass);
  1937.     obj_t fi_sing = singleton(obj_FixnumClass);
  1938.     obj_t ei_sing = singleton(obj_BignumClass);
  1939.     obj_t float_sing = singleton(obj_FloatClass);
  1940.     obj_t sf_sing = singleton(obj_SingleFloatClass);
  1941.     obj_t df_sing = singleton(obj_DoubleFloatClass);
  1942.     obj_t xf_sing = singleton(obj_ExtendedFloatClass);
  1943.  
  1944.     define_function("==", two_objs, FALSE, obj_False, FALSE, obj_BooleanClass,
  1945.             dylan_idp);
  1946.     define_method("=", two_objs, FALSE, obj_False, FALSE, obj_BooleanClass,
  1947.           dylan_idp);
  1948.  
  1949.     define_generic_function("truncate/", 2, FALSE, obj_False, FALSE,
  1950.                 int_and_real, obj_False);
  1951.     define_generic_function("truncate", 1, FALSE, obj_False, FALSE,
  1952.                 int_and_real, obj_False);
  1953.     define_generic_function("floor/", 2, FALSE, obj_False, FALSE,
  1954.                 int_and_real, obj_False);
  1955.     define_generic_function("floor", 1, FALSE, obj_False, FALSE,
  1956.                 int_and_real, obj_False);
  1957.     define_generic_function("ceiling/", 2, FALSE, obj_False, FALSE,
  1958.                 int_and_real, obj_False);
  1959.     define_generic_function("ceiling", 1, FALSE, obj_False, FALSE,
  1960.                 int_and_real, obj_False);
  1961.     define_generic_function("round/", 2, FALSE, obj_False, FALSE,
  1962.                 int_and_real, obj_False);
  1963.     define_generic_function("round", 1, FALSE, obj_False, FALSE,
  1964.                 int_and_real, obj_False);
  1965.  
  1966.     define_method("negative", fi, FALSE, obj_False, FALSE,
  1967.           obj_FixnumClass, dylan_fi_negative);
  1968.     define_method("+", two_fis, FALSE, obj_False, FALSE,
  1969.           obj_FixnumClass, dylan_fi_fi_plus);
  1970.     define_method("-", two_fis, FALSE, obj_False, FALSE,
  1971.           obj_FixnumClass, dylan_fi_fi_minus);
  1972.     define_method("*", two_fis, FALSE, obj_False, FALSE,
  1973.           obj_FixnumClass, dylan_fi_fi_times);
  1974.     add_method(find_variable(module_BuiltinStuff, symbol("truncate/"),
  1975.                  FALSE, FALSE)->value,
  1976.            make_raw_method("truncate/", two_fis, FALSE, obj_False, FALSE,
  1977.                    two_fis, obj_False, dylan_fi_fi_trunc));
  1978.     add_method(find_variable(module_BuiltinStuff, symbol("floor/"),
  1979.                  FALSE, FALSE)->value,
  1980.            make_raw_method("floor/", two_fis, FALSE, obj_False, FALSE,
  1981.                    two_fis, obj_False, dylan_fi_fi_floor));
  1982.     add_method(find_variable(module_BuiltinStuff, symbol("ceiling/"),
  1983.                  FALSE, FALSE)->value,
  1984.            make_raw_method("ceiling/", two_fis, FALSE, obj_False, FALSE,
  1985.                    two_fis, obj_False, dylan_fi_fi_ceil));
  1986.     add_method(find_variable(module_BuiltinStuff, symbol("round/"),
  1987.                  FALSE, FALSE)->value,
  1988.            make_raw_method("round/", two_fis, FALSE, obj_False, FALSE,
  1989.                    two_fis, obj_False, dylan_fi_fi_round));
  1990.     define_method("<", two_fis, FALSE, obj_False, FALSE,
  1991.           obj_BooleanClass, dylan_fi_fi_less);
  1992.     define_method("=", two_fis, FALSE, obj_False, FALSE,
  1993.           obj_BooleanClass, dylan_fi_fi_equal);
  1994.     define_method("ash", two_fis, FALSE, obj_False, FALSE,
  1995.           obj_FixnumClass, dylan_fi_ash);
  1996.     define_method("binary-logand", two_fis, FALSE, obj_False, FALSE,
  1997.           obj_FixnumClass, dylan_fi_fi_logand);
  1998.     define_method("logbit?", two_fis, FALSE, obj_False, FALSE,
  1999.           obj_BooleanClass, dylan_fi_logbitp);
  2000.     define_method("binary-logior", two_fis, FALSE, obj_False, FALSE,
  2001.           obj_FixnumClass, dylan_fi_fi_logior);
  2002.     define_method("lognot", fi, FALSE, obj_False, FALSE,
  2003.           obj_FixnumClass, dylan_fi_lognot);
  2004.     define_method("binary-logxor", two_fis, FALSE, obj_False, FALSE,
  2005.           obj_FixnumClass, dylan_fi_fi_logxor);
  2006.  
  2007.     define_method("=", two_eis, FALSE, obj_False, FALSE,
  2008.           obj_BooleanClass, dylan_ei_ei_equal);
  2009.     define_method("<", two_eis, FALSE, obj_False, FALSE,
  2010.           obj_BooleanClass, dylan_ei_ei_less);
  2011.     define_method("negative", ei, FALSE, obj_False, FALSE,
  2012.           obj_BignumClass, negate_bignum);
  2013.     define_method("+", two_eis, FALSE, obj_False, FALSE,
  2014.           obj_BignumClass, add_bignums);
  2015.     define_method("-", two_eis, FALSE, obj_False, FALSE,
  2016.           obj_BignumClass, subtract_bignums);
  2017.     define_method("*", two_eis, FALSE, obj_False, FALSE,
  2018.           obj_BignumClass, multiply_bignums);
  2019.     add_method(find_variable(module_BuiltinStuff, symbol("floor/"),
  2020.                  FALSE, FALSE)->value,
  2021.            make_raw_method("floor/", two_eis, FALSE, obj_False, FALSE,
  2022.                    two_eis, obj_False, dylan_ei_ei_floor));
  2023.     add_method(find_variable(module_BuiltinStuff, symbol("ceiling/"),
  2024.                  FALSE, FALSE)->value,
  2025.            make_raw_method("ceiling/", two_eis, FALSE, obj_False, FALSE,
  2026.                    two_eis, obj_False, dylan_ei_ei_ceil));
  2027.     add_method(find_variable(module_BuiltinStuff, symbol("truncate/"),
  2028.                  FALSE, FALSE)->value,
  2029.            make_raw_method("truncate/", two_eis, FALSE, obj_False, FALSE,
  2030.                    two_eis, obj_False, dylan_ei_ei_trunc));
  2031.     define_method("binary-logior", two_eis, FALSE, obj_False, FALSE,
  2032.           obj_BignumClass, dylan_ei_ei_logior);
  2033.     define_method("binary-logand", two_eis, FALSE, obj_False, FALSE,
  2034.           obj_BignumClass, dylan_ei_ei_logand);
  2035.     define_method("binary-logxor", two_eis, FALSE, obj_False, FALSE,
  2036.           obj_BignumClass, dylan_ei_ei_logxor);
  2037.     define_method("lognot", ei, FALSE, obj_False, FALSE,
  2038.           obj_BignumClass, dylan_ei_lognot);
  2039.     define_method("logbit?", list2(obj_FixnumClass, obj_BignumClass), FALSE,
  2040.           obj_False, FALSE, obj_BooleanClass, dylan_ei_logbitp);
  2041.     define_method("ash", list2(obj_BignumClass, obj_FixnumClass), FALSE,
  2042.           obj_False, FALSE, obj_BignumClass, dylan_ei_ash);
  2043.  
  2044.     define_method("make-ratio", two_ints, FALSE, obj_False,
  2045.           FALSE, obj_RatioClass, make_ratio);
  2046.     define_method("numerator", ratio, FALSE, obj_False, FALSE,
  2047.           obj_IntegerClass, dylan_numerator);
  2048.     define_method("denominator", ratio, FALSE, obj_False, FALSE,
  2049.           obj_IntegerClass, dylan_denominator);
  2050.     define_method("numerator-setter", list2(obj_ObjectClass, obj_RatioClass),
  2051.           FALSE, obj_False, FALSE, obj_IntegerClass,
  2052.           dylan_numerator_setter);
  2053.     define_method("denominator-setter", list2(obj_ObjectClass, obj_RatioClass),
  2054.           FALSE, obj_False, FALSE, obj_IntegerClass,
  2055.           dylan_denominator_setter);
  2056.  
  2057.     define_method("negative", sf, FALSE, obj_False, FALSE,
  2058.           obj_SingleFloatClass, dylan_sf_negative);
  2059.     define_method("+", two_sfs, FALSE, obj_False, FALSE, obj_SingleFloatClass,
  2060.           dylan_sf_sf_plus);
  2061.     define_method("-", two_sfs, FALSE, obj_False, FALSE, obj_SingleFloatClass,
  2062.           dylan_sf_sf_minus);
  2063.     define_method("*", two_sfs, FALSE, obj_False, FALSE, obj_SingleFloatClass,
  2064.           dylan_sf_sf_times);
  2065.     define_method("/", two_sfs, FALSE, obj_False, FALSE, obj_SingleFloatClass,
  2066.           dylan_sf_sf_divide);
  2067.     add_method(find_variable(module_BuiltinStuff, symbol("truncate"),
  2068.                  FALSE, FALSE)->value,
  2069.            make_raw_method("truncate", sf, FALSE, obj_False, FALSE,
  2070.                    int_and_sf, obj_False, dylan_sf_trunc));
  2071.     add_method(find_variable(module_BuiltinStuff, symbol("floor"),
  2072.                  FALSE, FALSE)->value,
  2073.            make_raw_method("floor", sf, FALSE, obj_False, FALSE,
  2074.                    int_and_sf, obj_False, dylan_sf_floor));
  2075.     add_method(find_variable(module_BuiltinStuff, symbol("ceiling"),
  2076.                  FALSE, FALSE)->value,
  2077.            make_raw_method("ceiling", sf, FALSE, obj_False, FALSE,
  2078.                    int_and_sf, obj_False, dylan_sf_ceil));
  2079.     add_method(find_variable(module_BuiltinStuff, symbol("round"),
  2080.                  FALSE, FALSE)->value,
  2081.            make_raw_method("round", sf, FALSE, obj_False, FALSE,
  2082.                    int_and_sf, obj_False, dylan_sf_round));
  2083.     define_method("<", two_sfs, FALSE, obj_False, FALSE, obj_BooleanClass,
  2084.           dylan_sf_sf_less);
  2085.     define_method("<=", two_sfs, FALSE, obj_False, FALSE, obj_BooleanClass,
  2086.           dylan_sf_sf_less_or_eql);
  2087.     define_method("=", two_sfs, FALSE, obj_False, FALSE, obj_BooleanClass,
  2088.           dylan_sf_sf_equal);
  2089.     define_method("~=", two_sfs, FALSE, obj_False, FALSE, obj_BooleanClass,
  2090.           dylan_sf_sf_not_equal);
  2091.     
  2092.     define_method("negative", df, FALSE, obj_False, FALSE,
  2093.           obj_DoubleFloatClass, dylan_df_negative);
  2094.     define_method("+", two_dfs, FALSE, obj_False, FALSE, obj_DoubleFloatClass,
  2095.           dylan_df_df_plus);
  2096.     define_method("-", two_dfs, FALSE, obj_False, FALSE, obj_DoubleFloatClass,
  2097.           dylan_df_df_minus);
  2098.     define_method("*", two_dfs, FALSE, obj_False, FALSE, obj_DoubleFloatClass,
  2099.           dylan_df_df_times);
  2100.     define_method("/", two_dfs, FALSE, obj_False, FALSE, obj_DoubleFloatClass,
  2101.           dylan_df_df_divide);
  2102.     add_method(find_variable(module_BuiltinStuff, symbol("truncate"),
  2103.                  FALSE, FALSE)->value,
  2104.            make_raw_method("truncate", df, FALSE, obj_False, FALSE,
  2105.                    int_and_df, obj_False, dylan_df_trunc));
  2106.     add_method(find_variable(module_BuiltinStuff, symbol("floor"),
  2107.                  FALSE, FALSE)->value,
  2108.            make_raw_method("floor", df, FALSE, obj_False, FALSE,
  2109.                    int_and_df, obj_False, dylan_df_floor));
  2110.     add_method(find_variable(module_BuiltinStuff, symbol("ceiling"),
  2111.                  FALSE, FALSE)->value,
  2112.            make_raw_method("ceiling", df, FALSE, obj_False, FALSE,
  2113.                    int_and_df, obj_False, dylan_df_ceil));
  2114.     add_method(find_variable(module_BuiltinStuff, symbol("round"),
  2115.                  FALSE, FALSE)->value,
  2116.            make_raw_method("round", df, FALSE, obj_False, FALSE,
  2117.                    int_and_df, obj_False, dylan_df_round));
  2118.     define_method("<", two_dfs, FALSE, obj_False, FALSE, obj_BooleanClass,
  2119.           dylan_df_df_less);
  2120.     define_method("<=", two_dfs, FALSE, obj_False, FALSE, obj_BooleanClass,
  2121.           dylan_df_df_less_or_eql);
  2122.     define_method("=", two_dfs, FALSE, obj_False, FALSE, obj_BooleanClass,
  2123.           dylan_df_df_equal);
  2124.     define_method("~=", two_dfs, FALSE, obj_False, FALSE, obj_BooleanClass,
  2125.           dylan_df_df_not_equal);
  2126.  
  2127.     define_method("negative", list1(obj_ExtendedFloatClass), FALSE, obj_False,
  2128.           FALSE, obj_ExtendedFloatClass, dylan_xf_negative);
  2129.     define_method("+", two_xfs, FALSE, obj_False, FALSE,
  2130.           obj_ExtendedFloatClass, dylan_xf_xf_plus);
  2131.     define_method("-", two_xfs, FALSE, obj_False, FALSE,
  2132.           obj_ExtendedFloatClass, dylan_xf_xf_minus);
  2133.     define_method("*", two_xfs, FALSE, obj_False, FALSE,
  2134.           obj_ExtendedFloatClass, dylan_xf_xf_times);
  2135.     define_method("/", two_xfs, FALSE, obj_False, FALSE,
  2136.           obj_ExtendedFloatClass, dylan_xf_xf_divide);
  2137.     add_method(find_variable(module_BuiltinStuff, symbol("truncate"),
  2138.                  FALSE, FALSE)->value,
  2139.            make_raw_method("truncate", xf, FALSE, obj_False, FALSE,
  2140.                    int_and_xf, obj_False, dylan_xf_trunc));
  2141.     add_method(find_variable(module_BuiltinStuff, symbol("floor"),
  2142.                  FALSE, FALSE)->value,
  2143.            make_raw_method("floor", xf, FALSE, obj_False, FALSE,
  2144.                    int_and_xf, obj_False, dylan_xf_floor));
  2145.     add_method(find_variable(module_BuiltinStuff, symbol("ceiling"),
  2146.                  FALSE, FALSE)->value,
  2147.            make_raw_method("ceiling", xf, FALSE, obj_False, FALSE,
  2148.                    int_and_xf, obj_False, dylan_xf_ceil));
  2149.     add_method(find_variable(module_BuiltinStuff, symbol("round"),
  2150.                  FALSE, FALSE)->value,
  2151.            make_raw_method("round", xf, FALSE, obj_False, FALSE,
  2152.                    int_and_xf, obj_False, dylan_xf_round));
  2153.     define_method("<", two_xfs, FALSE, obj_False, FALSE, obj_BooleanClass,
  2154.           dylan_xf_xf_less);
  2155.     define_method("<=", two_xfs, FALSE, obj_False, FALSE, obj_BooleanClass,
  2156.           dylan_xf_xf_less_or_eql);
  2157.     define_method("=", two_xfs, FALSE, obj_False, FALSE, obj_BooleanClass,
  2158.           dylan_xf_xf_equal);
  2159.     define_method("~=", two_xfs, FALSE, obj_False, FALSE, obj_BooleanClass,
  2160.           dylan_xf_xf_not_equal);
  2161.     
  2162.     define_method("as", list2(fi_sing, obj_FixnumClass),
  2163.           FALSE, obj_False, FALSE, obj_FixnumClass,
  2164.           dylan_as_identity);
  2165.     define_method("as", list2(ei_sing, obj_FixnumClass),
  2166.           FALSE, obj_False, FALSE, obj_BignumClass,
  2167.           dylan_fi_as_ei);
  2168.     define_method("as", list2(float_sing, obj_FixnumClass),
  2169.           FALSE, obj_False, FALSE, obj_SingleFloatClass,
  2170.           dylan_fi_as_sf);
  2171.     define_method("as", list2(sf_sing, obj_FixnumClass),
  2172.           FALSE, obj_False, FALSE, obj_SingleFloatClass,
  2173.           dylan_fi_as_sf);
  2174.     define_method("as", list2(df_sing, obj_FixnumClass),
  2175.           FALSE, obj_False, FALSE, obj_DoubleFloatClass,
  2176.           dylan_fi_as_df);
  2177.     define_method("as", list2(xf_sing, obj_FixnumClass),
  2178.           FALSE, obj_False, FALSE, obj_ExtendedFloatClass,
  2179.           dylan_fi_as_xf);
  2180.  
  2181.     define_method("as", list2(ei_sing, obj_BignumClass),
  2182.           FALSE, obj_False, FALSE, obj_BignumClass,
  2183.           dylan_as_identity);
  2184.     define_method("as", list2(fi_sing, obj_BignumClass),
  2185.           FALSE, obj_False, FALSE, obj_FixnumClass,
  2186.           dylan_ei_as_fi);
  2187.     define_method("as", list2(sf_sing, obj_BignumClass),
  2188.           FALSE, obj_False, FALSE, obj_SingleFloatClass,
  2189.           dylan_ei_as_sf);
  2190.     define_method("as", list2(df_sing, obj_BignumClass),
  2191.           FALSE, obj_False, FALSE, obj_DoubleFloatClass,
  2192.           dylan_ei_as_df);
  2193.     define_method("as", list2(xf_sing, obj_BignumClass),
  2194.           FALSE, obj_False, FALSE, obj_ExtendedFloatClass,
  2195.           dylan_ei_as_xf);
  2196.  
  2197.     define_method("as", list2(float_sing, obj_FloatClass),
  2198.           FALSE, obj_False, FALSE, obj_FloatClass,
  2199.           dylan_as_identity);
  2200.  
  2201.     define_method("as", list2(sf_sing, obj_SingleFloatClass),
  2202.           FALSE, obj_False, FALSE, obj_SingleFloatClass,
  2203.           dylan_as_identity);
  2204.     define_method("as", list2(df_sing, obj_SingleFloatClass),
  2205.           FALSE, obj_False, FALSE, obj_DoubleFloatClass,
  2206.           dylan_sf_as_df);
  2207.     define_method("as", list2(xf_sing, obj_SingleFloatClass),
  2208.           FALSE, obj_False, FALSE, obj_DoubleFloatClass,
  2209.           dylan_sf_as_xf);
  2210.  
  2211.     define_method("as", list2(sf_sing, obj_DoubleFloatClass),
  2212.           FALSE, obj_False, FALSE, obj_SingleFloatClass,
  2213.           dylan_df_as_sf);
  2214.     define_method("as", list2(df_sing, obj_DoubleFloatClass),
  2215.           FALSE, obj_False, FALSE, obj_DoubleFloatClass,
  2216.           dylan_as_identity);
  2217.     define_method("as", list2(xf_sing, obj_DoubleFloatClass),
  2218.           FALSE, obj_False, FALSE, obj_DoubleFloatClass,
  2219.           dylan_df_as_xf);
  2220.  
  2221.     define_method("as", list2(sf_sing, obj_ExtendedFloatClass),
  2222.           FALSE, obj_False, FALSE, obj_SingleFloatClass,
  2223.           dylan_xf_as_sf);
  2224.     define_method("as", list2(df_sing, obj_ExtendedFloatClass),
  2225.           FALSE, obj_False, FALSE, obj_DoubleFloatClass,
  2226.           dylan_xf_as_df);
  2227.     define_method("as", list2(xf_sing, obj_ExtendedFloatClass),
  2228.           FALSE, obj_False, FALSE, obj_DoubleFloatClass,
  2229.           dylan_as_identity);
  2230.  
  2231.     define_constant("$maximum-fixed-integer", MAX_FIXNUM);
  2232.     define_constant("$minimum-fixed-integer", MIN_FIXNUM);
  2233. }
  2234.